home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 52 / Amiga Format AFCD52 (Issue 136, May 2000).iso / -screenplay- / shareware / solitarexx / scripts / montecarlo2d.srx < prev    next >
Text File  |  2000-02-29  |  2KB  |  96 lines
  1. /************************************\
  2. ** MonteCarlo2D v1.0 for Solitarexx **
  3. **       by Michal Szafranski       **
  4. \************************************/
  5. OPTIONS RESULTS
  6.  
  7. tex = '"Monte Carlo 2D v1.0"'
  8. order.0 = '0 6 12 18 24 30 1 7 13 19 25 31 2 8 14 20 26 32 3 9 15 21 27 33 4 10 16 22 28 34 5 11 17 23 29 35 36'
  9. order.1 = '0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36'
  10. order.2 = '35 34 33 32 31 30 24 25 26 27 28 29 23 22 21 20 19 18 12 13 14 15 16 17 11 10 9 8 7 6 0 1 2 3 4 5 36'
  11. order.3 = '21 20 14 15 16 22 28 27 26 25 19 13 7 8 9 10 11 17 23 29 35 34 33 32 31 30 24 18 12 6 0 1 2 3 4 5 36'
  12. ADDBUTTON 0 10 "Start"
  13. ADDCYCLE 1 12 'Vert|Horiz|Snake|Spiral' 1
  14. ADDTEXT 4 30 tex 6
  15. ADDBUTTON 12 10 "Abort"
  16. ADDTEXT 13 12 '""' 6
  17. ADDTEXT 14 30 tex 6
  18. SELECTGUI 1
  19. SCREENSIZE 6 0 7 0
  20. DO i = 0 TO 35
  21.     NEWSTACK i 0 0 (i//6) (i%6)
  22.     stack.i = RESULT
  23. END
  24. NEWSTACK 36 0 1 6 0
  25. stack.36 = RESULT
  26. NEWSTACK 37 0 1 6 5
  27. waste = RESULT
  28. ADDCARDS stack.36
  29. ADDCARDS stack.36 SHUFFLED
  30.  
  31. DO FOREVER
  32.     ACTION
  33.     PARSE VAR RESULT act rest
  34.     IF act = 1 THEN EXIT
  35.     IF act = 3 THEN CALL GAME
  36. END
  37.  
  38. GAME:
  39.     CLEANUP stack.36
  40.     SELECTGUI 4
  41.     sel = 20
  42.     fin = 104
  43.     SETGADGET 13 STR '"Left: 104"'
  44.     GETGADGET 1
  45.     order = order.RESULT
  46.     CALL DODECK
  47.     DO FOREVER
  48.         ACTION
  49.         PARSE VAR RESULT act stack sid card
  50.         IF act = 1 THEN EXIT
  51.         IF act = 2 THEN SELECT
  52.             WHEN sid = 36 THEN CALL DODECK
  53.             WHEN sid < 36 & sel = 36 & card>0 THEN sel=sid
  54.             WHEN sid < 36 & sel < 36 & card>0 THEN CALL DOSTACKS
  55.             OTHERWISE ERRBEEP
  56.         END
  57.         IF act = 3 THEN DO
  58.             SELECTGUI 1
  59.             RETURN
  60.         END
  61.     END
  62. RETURN
  63. DODECK:
  64.     sel = 36
  65.     sfrom = 1
  66.     DO sto = 1 TO 36
  67.         asto = WORD(order,sto)
  68.         DO FOREVER
  69.             asfrom = WORD(order,sfrom)
  70.             CARDSELECT stack.asfrom 1
  71.             IF RESULT = '' THEN sfrom = sfrom +1
  72.             ELSE LEAVE
  73.             IF sfrom = 38 THEN RETURN
  74.         END
  75.         IF sfrom = 37 THEN mode = 'REVERSE'
  76.         ELSE mode = ''
  77.         IF asfrom = asto THEN sfrom = sfrom +1
  78.         ELSE MOVECARDS stack.asfrom stack.asto mode
  79.     END
  80. RETURN
  81. DOSTACKS:
  82.     CARDSELECT stack.sel 1
  83.     PARSE VAR RESULT . w1 .
  84.     CARDSELECT stack 1
  85.     PARSE VAR RESULT . w2 .
  86.     IF w1 = w2 & ABS((sel//6)-(sid//6))<2 & 2>ABS((sel%6)-(sid%6)) & sel~=sid THEN DO
  87.         MOVECARDS stack.sel waste
  88.         MOVECARDS stack waste
  89.         fin = fin - 2
  90.         IF fin = 0 THEN SETGADGET 13 STR '"Winner"'
  91.         ELSE SETGADGET 13 STR '"Left:' fin||'"'
  92.     END
  93.     ELSE ERRBEEP
  94.     sel = 36
  95. RETURN
  96.